home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Toolbox / Visual Basic Toolbox (P.I.E.)(1996).ISO / error_hn / rdblib / crypt.bas < prev    next >
Encoding:
BASIC Source File  |  1994-01-28  |  1.5 KB  |  42 lines
  1. Function crypt (Action As String, Key As String, Src As String) As String
  2. Dim Count As Integer, KeyPos As Integer, KeyLen As Integer, SrcAsc As Integer, Dest As String, Offset As Integer, TmpSrcAsc
  3. KeyLen = Len(Key)
  4.  
  5. If Action = "E" Then
  6.     Randomize
  7.     Offset = (Rnd * 10000 Mod 255) + 1
  8.     Dest = Hex$(Offset)
  9.  
  10.     For SrcPos = 1 To Len(Src)
  11.         SrcAsc = (Asc(Mid$(Src, SrcPos, 1)) + Offset) Mod 255
  12.         If KeyPos < KeyLen Then KeyPos = KeyPos + 1 Else KeyPos = 1
  13.         'Fill Dest$ with HEX representation of Encrypted field
  14.         'Hex used to keep nasties such as eof or lf from mangling stream
  15.         'Use format$ to make Hex$ return " 0" instead of "0" when the same
  16.         'values are Xor'ed together (Null) - keeps placeholder for decrypt
  17.         SrcAsc = SrcAsc Xor Asc(Mid$(Key, KeyPos, 1))
  18.         Dest = Dest + Format$(Hex$(SrcAsc), "@@")
  19.         Offset = SrcAsc
  20.  
  21.     Next
  22.  
  23. ElseIf Action = "D" Then
  24.     Offset = Val("&H" + Left$(Src, 2))
  25.     For SrcPos = 3 To Len(Src) Step 2
  26.         SrcAsc = Val("&H" + Trim(Mid$(Src, SrcPos, 2)))
  27.         If KeyPos < KeyLen Then KeyPos = KeyPos + 1 Else KeyPos = 1
  28.         TmpSrcAsc = SrcAsc Xor Asc(Mid$(Key, KeyPos, 1))
  29.         If TmpSrcAsc <= Offset Then
  30.             TmpSrcAsc = 255 + TmpSrcAsc - Offset
  31.         Else
  32.             TmpSrcAsc = TmpSrcAsc - Offset
  33.         End If
  34.         Dest = Dest + Chr(TmpSrcAsc)
  35.         Offset = SrcAsc
  36.     Next
  37.  
  38. End If
  39. crypt = Dest
  40. End Function
  41.  
  42.